Tcl Source Code

Check-in [8a040c000a]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Attempt to fix cmdAH test failures. Doesn't work.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | tip-716
Files: files | file ages | folders
SHA3-256: 8a040c000aa41a0e7df6753500b89f298aa5986bd9244e4fb127e1a4a259002c
User & Date: jan.nijtmans 2025-04-28 07:37:06.397
Context
2025-04-28
11:30
Fix cmdAH tests. See comments below.

Tcl_GetEncodingForUser will not be available until 9.1 for stu... check-in: 17bd2a7748 user: apnadkarni tags: tip-716

07:37
Attempt to fix cmdAH test failures. Doesn't work. check-in: 8a040c000a user: jan.nijtmans tags: tip-716
2025-04-18
14:04
Merge 9.0 check-in: 1d72e36587 user: jan.nijtmans tags: tip-716
Changes
Unified Diff Ignore Whitespace Patch
Changes to win/tclWinTest.c.
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 */

static Tcl_ObjCmdProc	TesteventloopCmd;
static Tcl_ObjCmdProc	TestvolumetypeCmd;
static Tcl_ObjCmdProc	TestwinclockCmd;
static Tcl_ObjCmdProc	TestwinsleepCmd;
static Tcl_ObjCmdProc	TestExceptionCmd;
static int		TestplatformChmod(const char *nativePath, int pmode);
static Tcl_ObjCmdProc	TestchmodCmd;

/*
 *----------------------------------------------------------------------
 *
 * TclplatformtestInit --
 *







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 */

static Tcl_ObjCmdProc	TesteventloopCmd;
static Tcl_ObjCmdProc	TestvolumetypeCmd;
static Tcl_ObjCmdProc	TestwinclockCmd;
static Tcl_ObjCmdProc	TestwinsleepCmd;
static Tcl_ObjCmdProc	TestExceptionCmd;
static int		TestplatformChmod(const char *nativePath, int pmode, Tcl_Encoding encoding);
static Tcl_ObjCmdProc	TestchmodCmd;

/*
 *----------------------------------------------------------------------
 *
 * TclplatformtestInit --
 *
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
/*
 * This "chmod" works sufficiently for test script purposes. Do not expect
 * it to be exact emulation of Unix chmod (not sure if that's even possible)
 */
static int
TestplatformChmod(
    const char *nativePath,
    int pmode)

{
    /*
     * Note FILE_DELETE_CHILD missing from dirWriteMask because we do
     * not want overriding of child's delete setting when testing
     */
    static const DWORD dirWriteMask =
	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA |







|
>







394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
/*
 * This "chmod" works sufficiently for test script purposes. Do not expect
 * it to be exact emulation of Unix chmod (not sure if that's even possible)
 */
static int
TestplatformChmod(
    const char *nativePath,
    int pmode,
    Tcl_Encoding encoding)
{
    /*
     * Note FILE_DELETE_CHILD missing from dirWriteMask because we do
     * not want overriding of child's delete setting when testing
     */
    static const DWORD dirWriteMask =
	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA |
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
    int isDir;
    TOKEN_USER *pTokenUser = NULL;
    Tcl_DString ds;

    res = -1; /* Assume failure */

    Tcl_DStringInit(&ds);
    Tcl_UtfToExternalDString(NULL, nativePath, -1, &ds);

    attr = GetFileAttributesA(Tcl_DStringValue(&ds));
    if (attr == 0xFFFFFFFF) {
	goto done; /* Not found */
    }

    isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0;







|







441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
    int isDir;
    TOKEN_USER *pTokenUser = NULL;
    Tcl_DString ds;

    res = -1; /* Assume failure */

    Tcl_DStringInit(&ds);
    Tcl_UtfToExternalDString(encoding, nativePath, -1, &ds);

    attr = GetFileAttributesA(Tcl_DStringValue(&ds));
    if (attr == 0xFFFFFFFF) {
	goto done; /* Not found */
    }

    isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0;
637
638
639
640
641
642
643

644
645
646
647
648
649
650
651
652



653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
TestchmodCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int i, mode;


    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
	return TCL_ERROR;
    }




    for (i = 2; i < objc; i++) {
	Tcl_DString buffer;
	const char *translated;

	translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
	if (translated == NULL) {
	    return TCL_ERROR;
	}
	if (TestplatformChmod(translated, mode) != 0) {
	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
		    (char *)NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&buffer);
    }
    return TCL_OK;







>









>
>
>









|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
TestchmodCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int i, mode;
    Tcl_DString ds;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Encoding encoding = Tcl_GetEncoding(interp, Tcl_GetEncodingNameForUser(&ds));
	Tcl_DStringFree(&ds);

    for (i = 2; i < objc; i++) {
	Tcl_DString buffer;
	const char *translated;

	translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
	if (translated == NULL) {
	    return TCL_ERROR;
	}
	if (TestplatformChmod(translated, mode, encoding) != 0) {
	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
		    (char *)NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&buffer);
    }
    return TCL_OK;